home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 0007.ZIP / SH.BAS < prev    next >
BASIC Source File  |  1984-01-10  |  3KB  |  96 lines
  1. 1000 '  " SH.BAS "   11-26-83
  2. 1010 '
  3. 1020 ' IBM/PC  DOS 1.1
  4. 1030 ' Original code by Howard Glosser
  5. 1040 ' Modified by Mike Lewis
  6. 1050 ' See Softalk - November 1983 (pages 77-85)
  7. 1060 '
  8. 1070 ' Screen handler demonstration
  9. 1080 ' Restore screens from BASIC using assembler routine SH.COM
  10. 1090 '
  11. 1100 '
  12. 1110 COLOR 7,0:CLS:KEY OFF
  13. 1120 FOR I=1 TO 10:KEY I,"":NEXT I
  14. 1130 DEF SEG:SUBRT$=STRING$(66,32)
  15. 1140 SUBLC%=VARPTR(SUBRT$)
  16. 1150 GOSUB 1620:BLOAD "sh.com",SCRN
  17. 1160 DIM STRSCRN1%(2000),STRSCRN2%(2000)
  18. 1170 STORE%=1:RESTR%=2
  19. 1180 '
  20. 1190 ' build screen 1
  21. 1200 FOR I=1 TO 10: FOR J=1 TO 71 STEP 10
  22. 1210   LOCATE I,J:PRINT "screen 1  ";
  23. 1220 NEXT J:NEXT I
  24. 1230 LOCATE 12,36:PRINT "SCREEN 1"
  25. 1240 FOR I=14 TO 23:FOR J=1 TO 71 STEP 10
  26. 1250   LOCATE I,J:PRINT "screen 1  ";
  27. 1260 NEXT J:NEXT I
  28. 1270 SCRNOPT%=STORE%:GOSUB 1620
  29. 1280 CALL SCRN(SCRNOPT%,STRSCRN1%(0))
  30. 1290 CLS:LOCATE 12,32:PRINT "Screen 1 stored"
  31. 1300 SOUND 500,1:SOUND 400,1
  32. 1310 GOSUB 1810:CLS
  33. 1320 '
  34. 1330 ' build screen 2
  35. 1340 FOR I=1 TO 10: FOR J=1 TO 71 STEP 10
  36. 1350   LOCATE I,J:PRINT "screen 2  ";
  37. 1360 NEXT J:NEXT I
  38. 1370 LOCATE 12,36:PRINT "SCREEN 2"
  39. 1380 FOR I=14 TO 23:FOR J=1 TO 71 STEP 10
  40. 1390   LOCATE I,J:PRINT "screen 2  ";
  41. 1400 NEXT J:NEXT I
  42. 1410 SCRNOPT%=STORE%:GOSUB 1620
  43. 1420 CALL SCRN(SCRNOPT%,STRSCRN2%(0))
  44. 1430 CLS:LOCATE 12,32:PRINT "Screen 2 stored"
  45. 1440 SOUND 500,1:SOUND 400,1
  46. 1450 GOSUB 1810
  47. 1460 '
  48. 1470 ' input routine
  49. 1480 CLS
  50. 1490 LOCATE 8,24:PRINT "*** READY TO RESTORE SCREENS ***"
  51. 1500 LOCATE 11,30:PRINT "1. Restore screen 1"
  52. 1510 LOCATE 12,30:PRINT "2. Restore screen 2"
  53. 1520 LOCATE 13,30:PRINT "3. End the program"
  54. 1530 COLOR 0,7:LOCATE 25,28:PRINT" ENTER YOUR CHOICE (1-3) ";:COLOR 7,0
  55. 1540 X$=INKEY$:IF X$="" THEN 1540
  56. 1550 IF LEN(X$)=2 THEN 1540
  57. 1560 IF ASC(X$)<49 OR ASC(X$)>51 THEN 1540
  58. 1570 X=VAL(X$)
  59. 1580 ON X GOSUB 1660,1710,1760
  60. 1590 GOSUB 1850
  61. 1600 GOTO 1470
  62. 1610 '
  63. 1620 ' find the current location of SUBRT$
  64. 1630 SCRN=PEEK(SUBLC%+1)+PEEK(SUBLC%+2)*256
  65. 1640 RETURN
  66. 1650 '
  67. 1660 ' restore screen 1
  68. 1670 SCRNOPT%=RESTR%:GOSUB 1620
  69. 1680 CALL SCRN(SCRNOPT%,STRSCRN1%(0))
  70. 1690 RETURN
  71. 1700 '
  72. 1710 ' restore screen 2
  73. 1720 SCRNOPT%=RESTR%:GOSUB 1620
  74. 1730 CALL SCRN(SCRNOPT%,STRSCRN2%(0))
  75. 1740 RETURN
  76. 1750 '
  77. 1760 ' finished
  78. 1770 CLS
  79. 1780 LOCATE 1
  80. 1790 END
  81. 1800 '
  82. 1810 ' delay
  83. 1820 FOR I=1 TO 1500:NEXT I
  84. 1830 RETURN
  85. 1840 '
  86. 1850 ' continue
  87. 1860 COLOR 0,7
  88. 1870 LOCATE 25,27:PRINT " Press any key to continue ";
  89. 1880 COLOR 7,0
  90. 1890 X$=INKEY$:IF X$="" THEN 1890
  91. 1900 CLS
  92. 1910 RETURN
  93. 1920 '
  94. 1930 '
  95. 1940 ' end of listing
  96.